#!/usr/bin/perl
use utf8;
use strict;
use warnings;
use List::Util qw(min max);
use POSIX qw(floor tzset mktime);
use URI::Escape qw(uri_escape_utf8);
use Time::HiRes qw (time usleep);
use WWW::Curl::Easy;
use Time::Piece;
use HTML::DOM;
use Data::Dumper;
use Storable;
use DBI;
use encoding 'utf8';

$| = 1;

# Версия бота
my $VERSION = '1.0.0';

# Timezone
$ENV{TZ} = 'Europe/Moscow';
tzset;

# Для аптайма
my $bot_time_start = time;

# ID темы
my $topic_id = 14466371;

# Хэшмап текущего состояния системы
my $state;
my $state_changed = 0;

# Путь к файлу, в котором будем хранить прошлое состояние (sid... etc)
my $state_tmp_path = "/tmp/anagram_bot_state.$topic_id.db";

# Настройки периодичности запросов
my $hits_per_interval = 3;
my $request_interval  = 1;
my $last_request_time = 0;
my $hits_count        = 0;

# Текущий CK
my $commit_key = '';

# Настройки бота
my $user_name    = "StackOverflow";
my $user_marker  = "....";
my $user_phone   = '0000';
my $user_cookies = '';

# Администраторы бота
my @admins = ['Zhumarin', 'Zhumarina', 'Azq2'];

# Настройки БД
my $db_dsn  = 'dbi:mysql:spaces_anagrams:localhost:3306';
my $db_user = 'root';
my $db_pass = 'qwerty';

# Сообщения для разных кол-в попыток
my @tries_msgs = (
	'не используя подсказок', 
	'используя одну подсказку', 
	'используя две подсказки'
);

# Баллы за разное кол-во попыток
my @tries_balls = (3, 2, 1);
my @tries_balls_name = ('балла', 'балла', 'балл');

# Английская неделя => Наша неделя
my @to_russion_wday = (6, 0, 1, 2, 3, 4, 5); 

# Локальный кэш юзеров
my $local_user_cache = {}; 

debug_notice("Starting...");

# Подключаемся к БД
my $db;
mysql_connect() or die "Failed connect to database.";

# Получаем ранее сериализованное состояние
# Вот мне лень же вынести и это в БД. Пусть будет в файле :3
$state = retrieve($state_tmp_path) if (-f $state_tmp_path);
unless (defined $state) {
	$state = {
		'sid'                  => '', 
		'last_message_id'      => 0, 
		'last_message_time'    => time(), 
		'current_quest_word'   => '', 
		'current_quest_answer' => '', 
		'current_quest_time'   => 0, 
		'current_quest_hints'  => 0, 
		'is_pw_message_send'   => 0, 
	};
	$state_changed = 1;
}

# Инициализация Curl
my $curl = WWW::Curl::Easy->new;
$curl->setopt(CURLOPT_HEADER, 1);
$curl->setopt(CURLOPT_ENCODING, "deflate");
$curl->setopt(CURLOPT_USERAGENT, "Anagram bot $VERSION ;)");

# Авторизируемся
auth(1);

my $dom;
my $res;

# Бесконечный цикл работы демона
my $delta;
my $word_length;
my $letters_per_try;
my $need_exit = 0;
while (1) {
	# Проверяем коннект mysql. Если нет - реконнектимся
	if (!$db->ping()) {
		send_message($topic_id, 0, "[b][color=red]Хьюстон, у нас проблемы! Потеряно соединение с mysql![/color][/b]");
		mysql_connect() or die "Failed connect to database.";
	}
	
	# Получаем тему целиком
	$res = request("http://spaces.ru/forums/?r=$topic_id");
	
	# Парсим CK
	if ($$res =~ /CK" value="(\d+)/) {
		$commit_key = $1;
	}
	
	$dom = new HTML::DOM (charset => 'UTF-8');
	$dom->write($$res);
	undef $res;
	
	my $new_last_message_id = 0;
	my $comments = get_comments($dom);
	foreach my $comment (reverse @$comments) {
		# Не обрабатываем старые сообщения
		next if ($comment->{id} <= $state->{last_message_id});
		
		# Пропускаем сообщения бота
		next if ($comment->{author} eq $user_name);
		
		# Добавляем в базу юзера
		unless (exists $local_user_cache->{$comment->{author}}) {
			$db->prepare(
				"INSERT IGNORE INTO `anagram_users` SET ".
				"`nick` = ?, `balls` = 0, `balls_day` = 0, `balls_week` = 0, ".
				"`total` = 0, `total_day` = 0, `total_week` = 0, `last_answer` = 0"
			) -> execute($comment->{author});
			$local_user_cache->{$comment->{author}} = 0;
		}
		
		# id последнего сообщения
		$new_last_message_id = $comment->{id} if (!$new_last_message_id);
		
		# Если написал один из админов и сообщение начинается с botctl
		if ($comment->{author} ~~ @admins and $comment->{text} =~ /^botctl \w+/) {
			my @command = split (' ', $comment->{text});
			if ($command[1] eq 'stat') {
				my $stat_msg = '';
				$stat_msg .= "[b]Версия:[/b] $VERSION\n";
				$stat_msg .= "[b]Текущий вопрос:[/b] ".$state->{current_quest_word}."\n";
				$stat_msg .= "[b]Текущий ответ:[/b] ".$state->{current_quest_answer}."\n"
					if (exists $command[2] && $command[2] eq 'unsafe');
				$stat_msg .= "[b]Время начала:[/b] ".$state->{current_quest_time}."\n";
				$stat_msg .= "[b]Время от начала вопроса:[/b] ".(time - $state->{current_quest_time})."\n";
				$stat_msg .= "[b]Количество попыток:[/b] ".$state->{current_quest_hints}."\n";
				
				send_message($topic_id, $comment->{id}, $stat_msg);
			} elsif ($command[1] eq 'uptime') {
				send_message($topic_id, $comment->{id}, "[b]Аптайм бота:[/b] ".count_time(time - $bot_time_start));
			} elsif ($command[1] eq 'users') {
				my $msg = "[spoiler=Статистика за текущую сессию (".localtime($bot_time_start)."):]\n";
				for my $user_name (keys %$local_user_cache) {
					$msg .= "[color=#79358c][b]".$user_name."[/b][/color] - ".$local_user_cache->{$user_name}." ответов\n";
				}
				$msg .= '[/spoiler]';
				send_message($topic_id, $comment->{id}, $msg);
			} elsif ($command[1] eq 'stop') {
				send_message($topic_id, $comment->{id}, "[color=red]Бот отключен по команде от [b]".$comment->{author}."[/b]! :'( [/color]");
				$need_exit = 1;
			}
			# next;
		}
		
		if ($state->{'current_quest_time'}) { # Если есть текущий вопрос
			# Проверяем ответ
			if (lc $comment->{text} eq lc $state->{current_quest_answer}) {
				my $balls = $tries_balls[$state->{current_quest_hints}];
				my $total_balls;
				my $total_answers;
				
				my $sth = $db->prepare("SELECT * FROM `anagram_users` WHERE `nick` = ?");
				if ($sth->execute($comment->{author}) != 0E0) {
					my $user = $sth->fetchrow_hashref();
					my $current_timestamp = int(time);
					
					$total_balls = $user->{balls} + $balls;
					$total_answers = $user->{total} + 1;
					
					my @time = localtime($current_timestamp);
					my @user_time = localtime($user->{last_answer});
					
					my @eow = localtime(mktime(0, 0, 0, ($time[3] - $to_russion_wday[$time[6]]) + 6, $time[4], $time[5]));
					
					# debug_notice($eow[5]." ".$eow[4]." ".$eow[3]);
					
					my $is_day_expired = (
						$user_time[5] != $time[5] || 
						$user_time[4] != $time[4] || 
						$user_time[3] != $time[3]
					) ? 1 : 0;
					my $is_week_expired = (
						$eow[5] < $user_time[5] ||
						$eow[4] < $user_time[4] ||
						$eow[3] < $user_time[3]
					) ? 1 : 0;
					
					my $balls_day = $is_day_expired ? $balls : $balls + $user->{balls_day};
					my $balls_week = $is_week_expired ? $balls : $balls + $user->{balls_week};
					my $total_day = $is_day_expired ? 1 : $user->{total_day} + 1;
					my $total_week = $is_week_expired ? 1 : $user->{total_week} + 1;
					
					my $st = $db->prepare_cached(
						"UPDATE `anagram_users` SET ".
						"`balls` = `balls` + ?, ".
						"`balls_day` = ?, ".
						"`balls_week` = ?, ".
						"`total` = `total` + 1, ".
						"`total_day` = ?, ".
						"`total_week` = ?, ".
						"`last_answer` = ? ".
						"WHERE `nick` = ?"
					); 
					$st->execute(
						$balls, $balls_day, $balls_week, 
						$total_day, $total_week, $current_timestamp, 
						$comment->{author}
					);
					$local_user_cache->{$comment->{author}}++;
				}
				
				send_message(
					$topic_id, $comment->{id}, 
					"Молодец, [color=#79358c][b]".$comment->{author}."[/b][/color]!\n".
					"Ты угадал правильное слово \"[b]".$state->{current_quest_answer}."[/b]\" ".
					$tries_msgs[$state->{current_quest_hints}]." и заработал ".
					$tries_balls[$state->{current_quest_hints}]." ".
					$tries_balls_name[$state->{current_quest_hints}]."! (Всего ".$total_balls.")\n".
					"Это твой ".$total_answers."-й ответ!\n".
					"Следующее слово через несколько секунд..."
				);
				debug_notice($comment->{author}." guessed word! (hints: ".$state->{current_quest_hints}.")");
				
				# Сбрасываем состояние
				update_state_value('current_quest_word', '');
				update_state_value('current_quest_answer', '');
				update_state_value('current_quest_time', 0);
				update_state_value('current_quest_hints', 0);
				sleep(15);
			}
		}
	}
	
	if ($state->{'current_quest_time'}) {
		$delta = time() - $state->{'current_quest_time'};
		$word_length = length $state->{'current_quest_answer'};
		$letters_per_try = max(1, floor($word_length / 5));
		
		# Проверяем, не вышло ли время отведённое под ответ
		if ($delta > 90 || ($delta > 30 && $word_length < 3) || ($delta > 60 && $word_length < 4)) {
			debug_notice("Timeout! Word is not guessed!");
			send_message(
				$topic_id, 0, 
				"[color=red]Время истекло! Слово не было угадано! Следующее слово через несколько секунд...[/color]"
			);
			
			# Сбрасываем состояние
			update_state_value('current_quest_word', '');
			update_state_value('current_quest_answer', '');
			update_state_value('current_quest_time', 0);
			update_state_value('current_quest_hints', 0);
			sleep(15);
		}
	}
	
	if ($state->{'current_quest_time'}) {
		# Если нужно - выводим подсказки
		if ($state->{'current_quest_hints'} == 0 && $delta > 30) {
			my $hint = make_hint($state->{current_quest_answer}, $letters_per_try);
			update_state_value('current_quest_hints', 1);
			debug_notice("First hint: $hint");
			send_message(
				$topic_id, 0, 
				"[color=darkblue]Первая подсказка: [b]".$hint."[/b][/color]"
			);
		} elsif ($state->{'current_quest_hints'} == 1 && $delta > 60) {
			my $hint = make_hint($state->{current_quest_answer}, $letters_per_try * 2);
			update_state_value('current_quest_hints', 2);
			debug_notice("Second hint: $hint");
			send_message(
				$topic_id, 0, 
				"[color=darkblue]Вторая подсказка: [b]".$hint."[/b][/color]"
			);
		}
	} elsif (time() - $state->{last_message_time} < 1200) { # Если текущего вопроса нет - задаём
		my $quest_sth = $db->prepare("SELECT `word`, `answer` FROM `anagrams` ORDER BY RAND() LIMIT 1");
		$quest_sth->execute();
		my $quest = $quest_sth->fetchrow_hashref();
		
		update_state_value('current_quest_word', $quest->{'word'});
		update_state_value('current_quest_answer', $quest->{'answer'});
		update_state_value('current_quest_time', time);
		update_state_value('current_quest_hints', 0);
		update_state_value('is_pw_message_send', 0);
		
		Encode::_utf8_on($state->{'current_quest_word'});
		Encode::_utf8_on($state->{'current_quest_answer'});
		
		debug_notice("New word '".$state->{'current_quest_word'}."' (answer: ".$state->{'current_quest_answer'}.")");
		send_message(
			$topic_id, 0, 
			"[color=darkblue]Соберите правильное слово из: [b]".shift_word($state->{'current_quest_word'})."[/b] (".length($state->{'current_quest_word'})." букв)[/color]"
		);
	} elsif (!$state->{is_pw_message_send}) { # Прошло 10 минут и так никто и не хочет играть :( 
		send_message(
			$topic_id, 0, 
			"[color=darkblue]Эх... никто не хочет со мной играть уже аж 10 минут :'(\n".
			"Уйду я от вас...\n".
			"Что бы позвать меня и начать опять играть напишите любое сообщение. [/color]"
		);
		update_state_value('is_pw_message_send', 1);
		debug_notice("Suspend...");
	}
	
	# Обновляем id и время последнего сообщения
	if ($state->{last_message_id} < $new_last_message_id) {
		update_state_value('last_message_id', $new_last_message_id);
		update_state_value('last_message_time', time);
	}
	
	# Сохраняем текущее состояние
	update_state();
	
	# Отключение бота
	last if ($need_exit);
	
	# В режиме сна выбираем сообщения раз в 2 секунды
	sleep(2) if (time() - $state->{last_message_time} < 1200);
}

debug_warning("Bot shutdown... (uptime: ".count_time(time() - $bot_time_start).")");

sub make_hint {
	my ($word, $n) = @_;
	my $out = '';
	$out .= substr ($word, 0, $n);
	my $len = length $word;
	for (my $i = 0; $i < $len - $n; ++$i) {
		$out .= '*';
	}
	return $out;
}

sub shift_word {
	my $word = shift;
	$word =~ s/а/a/giu;
	$word =~ s/у/y/giu;
	$word =~ s/о/o/giu;
	$word =~ s/е/e/giu;
	$word =~ s/х/x/giu;
	$word =~ s/с/c/giu;
	return $word;
}

# Коннект к mysql
sub mysql_connect {
	my $tries = 32;
	while ($tries--) {
		$db = DBI->connect($db_dsn, $db_user, $db_pass, {RaiseError => 0, AutoCommit => 1}); 
		if (defined $db->err) {
			debug_error ("Can't connect to mysql: ".$db->errstr);
			next;
		}
		$db->do("SET NAMES 'utf8'");
		return 1;
	}
	return 0;
}

# Обновить значение состояния
sub update_state_value {
	my ($key, $value) = @_;
	if ($state->{$key} ne $value) {
		$state->{$key} = $value;
		$state_changed = 1;
	}
}

# Обновить состояние
sub update_state {
	if ($state_changed) {
		store $state, $state_tmp_path;
		$state_changed = 0;
	}
}

# Получить все комментарии их топика
sub get_comments {
	my ($dom) = @_;
	my $elements = get_elements_by_tag_name($dom, "div", "class", 'list_item oh');
	my @comments;
	
	my $id; my $author; my $text;
	foreach my $element (@$elements) {
		eval {
			$id = $element->id;
			$author = trim(get_element_by_tag_name($element, 'span', 'style', 'color:#79358c')->innerText);
			my $text_node = get_element_by_tag_name($element, 'div', 'class', 'clear');
			my $quote = get_element_by_tag_name($text_node, 'div', 'id', 'quote-'.$id);
			$text_node->removeChild($quote) if ($quote);
			$text = trim($text_node->innerText);
		};
		
		if ($@) {
			debug_error ("Can't parse comment data: $@");
			next;
		}
		
		push @comments, {id => $id, author => $author, text => $text};
	}
	return \@comments;
}

# Получит элементы дерева по имени тега и аттрибуту
sub get_elements_by_tag_name {
	my ($dom, $tag_name, $attr_name, $value) = @_;
	my @result;
	my $elements = $dom->getElementsByTagName($tag_name);
	foreach my $element (@$elements) {
		push @result, $element
			if ($element->getAttribute($attr_name) eq $value);
	}
	return \@result;
}

# Получит элемент дерева по имени тега и аттрибуту
sub get_element_by_tag_name {
	my ($dom, $tag_name, $attr_name, $value) = @_;
	my $elements = $dom->getElementsByTagName($tag_name);
	foreach my $element (@$elements) {
		return $element
			if ($element->getAttribute($attr_name) eq $value);
	}
	return undef;
}

# Отправить сообщение в форуме
sub send_message {
	my ($tid, $cid, $message) = @_;
	my $res;
	my $tries = 6;
	
	while ($tries--) {
		if ($cid) {
			$commit_key = get_ck("http://spaces.ru/forums/?cr=$cid") unless ($commit_key);
			$res = request("http://spaces.ru/forums/?cr=$cid", {
				body => $message, to => $cid, 
				cfms => 'Добавить', CK => $commit_key
			});
		} else {
			$commit_key = get_ck("http://spaces.ru/forums/?r=$tid") unless ($commit_key);
			$res = request("http://spaces.ru/forums/?r=$tid", {
				body => $message, id => $tid, 
				cfms => 'Добавить', CK => $commit_key
			});
		}
		
		last if ($$res =~ /<p>The document has moved/);
		if (($$res =~ /<div class="list_item error_block">(.*?)<\/div>/u) || ($$res =~ /<small id="errorField">(.*?)<\/small>/u)) {
			debug_error ("Can't send message! (text: ".uri_escape_utf8($message).", tid: $tid, cid: $cid): $1");
			last if ($1 =~ /Вы уже добавили такой комментарий ранее/u);
			#$message .= ' :)';
		} elsif ($$res =~ /Internal Server Error/) {
			debug_error ("Can't send message! (text: ".uri_escape_utf8($message).", tid: $tid, cid: $cid): Internal Server Error!");
		} else {
			debug_error ("Can't send message! (text: ".uri_escape_utf8($message).", tid: $tid, cid: $cid): Unknown error. ");
		}
		$commit_key = ''; # Сбросим на всякий случай CK
		
		sleep(1);
	}
}

# Получить commit key
sub get_ck {
	my $url = shift;
	my $tries = 3;
	my $ck = '';
	
	while ($tries--) {
		$res = request($url);
		if (($$res =~ /CK=(\d+)/) || ($$res =~ /CK" value="(\d+)/)) {
			$ck = $1;
			last;
		}
		
		if ($$res =~ /<div class="list_item error_block">(.*?)<\/div>/) {
			debug_error ("Can't get CK (url = $url): $1");
		} elsif ($$res =~ /Internal Server Error/) {
			debug_error ("Can't get CK (url = $url): Internal Server Error");
		} else {
			debug_error ("Can't get CK (url = $url): Unknown error. ");
		}
		sleep(1);
	}
	
	return $ck;
}

# Авторизация на Spaces
sub auth {
	my ($from_state) = @_;
	
	if ($from_state && exists $state->{sid}) {
		$curl->setopt(CURLOPT_COOKIE, $user_cookies."sid=".$state->{sid});
		return 1;
	}
	
	# Сбросим куки
	$curl->setopt(CURLOPT_COOKIE, $user_cookies);
	
	my $res = request("http://spaces.ru/tm/$user_marker");
	if ($$res =~ /error">Недействительная закладка/) {
		debug_error ("$user_marker is invalid bookmark!");
		exit; # дальше уже нет смысла просто
	}
	
	# Парсим sid
	unless ($$res =~ /sid=(\d+)/) {
		debug_error ("Can't parse sid!");
		return 0;
	}
	
	# Слишком часто пробуем авторизироваться
	if ($$res =~ /error">Вы очень часто входите на Spaces/u) {
		debug_error ("Too frequently login! Waiting 5 minutes...");
		sleep(601);
		return auth();
	}
	
	# Задаём sid в куки
	$state->{sid} = $1;
	$curl->setopt(CURLOPT_COOKIE, $user_cookies."sid=".$state->{sid});
	
	# Обновляем состояние
	update_state();
	
	return 1;
}

# Функция для выполнения запроса
sub request {
	my ($url, $data) = @_;
	my $time_delta = time() - $last_request_time;
	
	if ($time_delta < $request_interval) {
		if ($hits_count >= $hits_per_interval) {
			usleep(($request_interval - $time_delta) * 1000000);
			$hits_count = 0;
		}
	} else {
		$hits_count = 0;
	}
	
	if (defined $data) {
		my $post_data = "";
		my @keys = (keys %$data);
		foreach my $key (@keys) {
			$post_data .= uri_escape_utf8($key)."=".uri_escape_utf8($data->{$key});
			$post_data .= "&" if ($key ne $keys[-1]);
		}
		$curl->setopt(CURLOPT_POST, 1);
		$curl->setopt(CURLOPT_POSTFIELDS, $post_data);
	} else {
		$curl->setopt(CURLOPT_POST, 0);
	}
	
	$curl->setopt(CURLOPT_URL, $url);
	my $res;
	$curl->setopt(CURLOPT_WRITEDATA, \$res);
	$curl->perform;
	$last_request_time = time();
	++$hits_count;
	
	$curl->setopt(CURLOPT_POST, 0) if (defined $data);
	
	# Требование авторизации
	if ($res =~ /(welcome=1" class="user_color_link"|Location: http:\/\/spaces.ru\/registration)/u) {
		debug_warning("Need auth!");
		# Авторизируемся
		auth(0);
		# Пробуем опять
		return request($url, $data);
	}
	
	# Запрос номера телефона
	if ($res =~ /name="pn_nums"/) {
		debug_warning("Need phone number!");
		request("http://spaces.ru/mysite/", {
			name => $user_name, 
			pn_nums => $user_phone
		});
		# Пробуем опять
		return request($url, $data);
	}
	
	return \$res;
}

# Обрезание строки от пробельных символов
sub trim {
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}

# Подсчёт аптайма
sub count_time {
	my $time = int(shift);
	
	my @out = (); 
	my $days = floor($time / (3600 * 24)); 
	
	if ($days > 0) {
		$time -= $days * 3600 * 24; 
		push @out, $days." дней"; 
	}
	
	my $hours = floor($time / 3600); 
	if ($hours > 0 || $days > 0) {
		$time -= $hours * 3600; 
		push @out, $hours." часов"; 
	}
	
	my $minutes = floor($time / 60); 
	if ($minutes > 0 || $hours > 0 || $days > 0) {
		$time -= $minutes * 60; 
		push @out, $minutes." минут"; 
	}
	
	push @out, $time." секунд" if (!@out || $time > 0);
	return join(', ', @out); 
}

# Функции вывода сообщений в лог
sub debug_error {
	my $message = shift;
	print "[".localtime->strftime."] [error] $message\n";
}

sub debug_warning {
	my $message = shift;
	print "[".localtime->strftime."] [warning] $message\n";
	
}

sub debug_notice {
	my $message = shift;
	print "[".localtime->strftime."] [notice] $message\n";
	
}

